home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / 1svga.zip / PRINTC.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-21  |  3KB  |  84 lines
  1. { Show 24x24 Chinese Font }
  2.  
  3. uses SVGA256,Txt;
  4.  
  5. var FontAsc,FontSpc,FontSup:pointer;
  6.     FileChn:string;      { 12288,29376,26280 bytes }
  7.  
  8. { ─────────────── InitChinese ─────────────── }
  9. procedure InitChinese(Chn,Asc,Spc,Sup:string);
  10. begin
  11.   if (FileLen(Chn,1)<0) then
  12.     begin Writeln; Writeln(''''+Chn+''' not found !'); Halt(1); end;
  13.   if (FileLen(Asc,1)<0) then
  14.     begin Writeln; Writeln(''''+Asc+''' not found !'); Halt(1); end;
  15.   if (FileLen(Spc,1)<0) then
  16.     begin Writeln; Writeln(''''+Spc+''' not found !'); Halt(1); end;
  17.   if (FileLen(Sup,1)<0) then
  18.     begin Writeln; Writeln(''''+Sup+''' not found !'); Halt(1); end;
  19.   FileChn:=Chn;
  20.   GetMem(FontAsc,12288); FileRead(Asc,0,256,48,FontAsc^);
  21.   GetMem(FontSpc,29376); FileRead(Spc,0,408,72,FontSpc^);
  22.   GetMem(FontSup,26280); FileRead(Sup,0,365,72,FontSup^);
  23. end;
  24. { ─────────────── PrintC ─────────────── }
  25. procedure PrintC(Ty,X,Y,Color,BkColor,Space,Count:integer;St:string);
  26. var Buf1,Buf2:array[0..575] of byte;    { Ty: 0=Mono, 1..4=Color }
  27.     S1,O1,S2,O2,S3,O3,I,Hi,Lo,N,L,P:integer;
  28.     C:word;
  29.     File1:file;
  30. begin
  31.   S1:=Seg(FontAsc^); O1:=Ofs(FontSpc^);
  32.   S2:=Seg(FontSpc^); O2:=Ofs(FontSpc^);
  33.   S3:=Seg(FontSup^); O3:=Ofs(FontSup^);
  34.   Assign(File1,FileChn); Reset(File1,72);
  35.   L:=Length(St); P:=0;
  36.   while P<L do begin
  37.     Hi:=Ord(St[P+1]); Lo:=Ord(St[P+2]); C:=Hi shl 8+Lo;
  38.     case C of
  39.       $A440..$C67E,$C940..$F9FE:begin
  40.     if Lo>$7E then Dec(Lo,34);
  41.     N:=157*(Hi-$A4)+Lo-$40;    if N>5400 then Dec(N,408);
  42.     if N<13094 then begin Seek(File1,N); BlockRead(File1,Buf1,1); end
  43.       else Move(Mem[S2:O2+6192],Buf1,72);
  44.     Conv1to8(Buf1,Buf2,72,Color,BkColor);
  45.     Hi:=24; Lo:=24+Space; N:=2;
  46.       end;
  47.       $A140..$A3BF:begin
  48.     if Lo>$7E then Dec(Lo,34);
  49.     N:=157*(Hi-$A1)+Lo-$40;
  50.     Conv1to8(Mem[S2:O2+72*N],Buf2,72,Color,BkColor);
  51.     Hi:=24; Lo:=24+Space; N:=2;
  52.       end;
  53.       $C6A1..$C8FE:begin
  54.     N:=157*(Hi-$C6)+Lo-$A1;
  55.     Conv1to8(Mem[S3:O3+72*N],Buf2,72,Color,BkColor);
  56.     Hi:=24; Lo:=24+Space; N:=2;
  57.       end else begin
  58.     Conv1to8(Mem[S1:O1+48*Hi],Buf2,48,Color,BkColor);
  59.     Hi:=16; Lo:=12+Space shr 1; N:=1;
  60.       end;
  61.     end;
  62.     if Ty>0 then Colorize(Ty,Hi,24,Color,Count,Color,Buf2);
  63.     Put(X,Y,Hi,24,Buf2);
  64.     Inc(X,Lo); Inc(P,N);
  65.   end;
  66.   Close(File1);
  67. end;
  68.  
  69. const St:array[0..3] of string[30]=
  70.   ('┼w¬∩¿╧Ñ╬Ñ╗╣q╕ú¿t▓╬,',
  71.    'Ñ╗╣q╕ú¿t▓╬¼░│»¼w¿k⌐╥ª│,',
  72.    '╖q╜╨╖R▒ñ¿╧Ñ╬╕Ω╖╜!',
  73.    'í╣ Jou-Nan Chen 1994 í╣');
  74. var I:integer;
  75. begin
  76.   SetMode(3);
  77.   Bar(0,0,640,480,104);
  78.   InitChinese('\et3\stdfont.24l','\et3\ascfont.24','\et3\spcfont.24',
  79.     '\et3\spcfsupp.24');
  80.   for I:=0 to 3 do PrintC(1,120,80+48*I,64+8*I,104,4,2,St[I]);
  81.   I:=Key;
  82.   SetMode(0);
  83. end.
  84.